home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / arg.ml next >
Encoding:
Text File  |  1993-09-24  |  1.8 KB  |  69 lines  |  [TEXT/MPS ]
  1. (* arg.ml *)
  2.  
  3. #open "exc";;
  4. #open "eq";;
  5. #open "int";;
  6. #open "fvect";;
  7. #open "fstring";;
  8. #open "fchar";;
  9. #open "io";;
  10. #open "list";;
  11.  
  12.  
  13. type error =
  14.   Unknown of string
  15. | Wrong of string * string * string  (* option, actual, expected *)
  16. | Missing of string
  17. | Message of string
  18. ;;
  19.  
  20. let stop error =
  21.   let progname = if vect_length sys__command_line > 0
  22.                  then sys__command_line.(0)
  23.                  else "(?)"
  24.   in let message = match error
  25.      with Unknown s -> progname ^ ": unknown option: \"" ^ s ^ "\"."
  26.         | Missing s
  27.           -> progname ^ ": option \"" ^ s ^ "\" needs an argument."
  28.         | Wrong (opt, arg, expected)
  29.           -> progname ^ ": wrong argument \"" ^ arg ^ "\"; option \""
  30.              ^ opt ^ "\" expects " ^ expected ^ "."
  31.         | Message s
  32.           -> progname ^ ": " ^ s
  33.   in
  34.      prerr_endline message;
  35.      exit 2
  36. ;;
  37.  
  38. let parse speclist anonfun =
  39.   let rec p = function
  40.       [] -> ()
  41.     | s::t -> if string_length s >= 1 & nth_char s 0 = `-`
  42.               then do_key s t
  43.               else begin try (anonfun s); p t
  44.                    with Bad m -> stop (Message m)
  45.                    end
  46.   and do_key s l =    
  47.     let action =
  48.       try
  49.         assoc s speclist
  50.       with Not_found -> stop (Unknown s) in
  51.     try match (action, l)
  52.         with (Unit f, l) -> f (); p l
  53.            | (String f, arg::t) -> f arg; p t
  54.            | (Int f, arg::t)
  55.              -> begin try f (int_of_string arg)
  56.                 with Failure "int_of_string"
  57.                      -> stop (Wrong (s, arg, "an integer"))
  58.                 end;
  59.                 p t
  60.            | (Float f, arg::t) -> f (float__float_of_string arg); p t
  61.            | (_, []) -> stop (Missing s)
  62.     with Bad m -> stop (Message m)
  63.   in
  64.     match list_of_vect sys__command_line with
  65.         [] -> ()
  66.     | a::l -> p l
  67. ;;
  68.  
  69.